procedure CheckForStack;
begin
  if nPics=0 then begin
    PutMessage('This macro requires a stack.');
    exit;
  end;
  if nSlices=0 then begin
    PutMessage('This window is not a stack.');
    exit
  end;
end;


procedure CheckForSelection;
var 
  x1,y1,x2,y2,LineWidth:integer;
begin
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  GetLine(x1,y1,x2,y2,LineWidth);
  if (RoiWidth=0) or (x1>=0) then begin
    PutMessage('Please make a rectangular selection.');
    exit;
  end;
end;


procedure CropScaleNN;
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  angle:=GetNumber('rotation angle (clw > 0):',0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);

  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;

  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;

  if not OneToOne then begin
    SetScaling('Nearest; Create New Window');
  end;

  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;


procedure CropScaleBL;
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  angle:=GetNumber('rotation angle (clw > 0):',0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);

  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;

  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;

  if not OneToOne then begin
    SetScaling('Bilinear; Create New Window');
  end;

  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;


procedure CropScaleBC;
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  angle:=GetNumber('rotation angle (clw > 0):',0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);

  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;

  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;

  if not OneToOne then begin
    SetScaling('Bicubic; Create New Window');
  end;

  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;


macro 'import raw image  [I]';
var
w,h:   integer;
begin
w:= GetNumber('width: ',1350);
h:= GetNumber('height: ',1000);
SetImport('Custom');
SetCustom(w,h,0);
Import('image');
end;


macro 'Insert slice at start [0]';    
begin CheckForStack; 
SelectSlice(1);
SelectAll;
Copy;
Clear;
AddSlice;
SelectSlice(2);
Paste; 
end;




macro '(-' begin end;


macro 'make ROI there [X]';
var
x,y,left,top,width,height:integer;
begin
GetMouse(x,y);
GetPicSize(width,height);
 left:=GetNumber('left:',x);
 top:=GetNumber('top:',y);
 width:=GetNumber('width:',1200);
 height:=GetNumber('height:',1000);
MakeRoi(left,top,width,height);
end;




macro '(-' begin end;

macro 'crop and scale - NN         [1]';
begin CropScaleNN; end;

macro 'crop and scale - bilinear  [2]';
begin CropScaleBL; end;

macro 'crop and scale - bicubic   [3]';
begin CropScaleBC; end;




macro '(-' begin end;


macro 'flip stack horizontal       [4]';
var
  i,invno,width,height,nSlice:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
	  FlipHorizontal;
  end;
end;

macro 'flip stack vertical            [5]';
var
  i,invno,width,height,nSlice:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
	  FlipVertical;
  end;
end;

macro 'rotate entire stack 180 [6]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
	 FlipHorizontal;
  FlipVertical;
  end;
end;





macro '(-' begin end;


macro 'revert ROTs in stack';
var
  i,k,n,OldStack,NewStack:integer;
  w,h,start:integer;
begin

  CheckForStack;
  SaveState;
  OldStack:=PicNumber;
  n:=nSlices;
  GetPicSize(w,h);

  SetNewSize(w,h);
  MakeNewStack('Stack ROT reversed');
  NewStack:=PicNumber;

start:=GetNumber('first of 19 rotations on slice no.: ',3);

SelectPic(OldStack);
SelectSlice(1);
SelectAll;
Copy;
SelectPic(Newstack);
SelectSlice(1);
Paste;
DoCopy;


for i:= 2 to start do begin
SelectPic(OldStack);
SelectSlice(i);
SelectAll;
Copy;
SelectPic(Newstack);
AddSlice;
Paste;
DoCopy;
end;

for i:= 1 to 17 do begin

k:= start+(18-i);

SelectPic(OldStack);
SelectSlice(k);
SelectAll;
Copy;
SelectPic(Newstack);
AddSlice;
Paste;
DoCopy;
end;

for i:= (start+18) to n do begin
SelectPic(OldStack);
SelectSlice(i);
SelectAll;
Copy;
SelectPic(Newstack);
AddSlice;
Paste;
DoCopy;
end;

  RestoreState;

end;



macro 'rotate stack to reference  [R]';
var
  i,inc,sense,start,iend,nrot:integer;
begin
 CheckForStack;

PutMessage('Slices before reference are not rotated, slices after 180 are rotated to 180 only');

 sense:=1;
 start:=1;
 inc:=GetNumber('increment:',10);
 sense:=GetNumber('should rotate (CLW=1 CCLW=0) ?',sense);
 start:=GetNumber('reference slice',start);
 nrot:=180/inc + 1;
 iend:=start+nrot;
 
if iend > nSlices then begin
iend := nSlices;
end;

 nrot:=GetNumber('nrot',nrot);
 iend:=GetNumber('iend',iend);

 if sense = 0 then begin
  inc:=-inc;
  end;
  
   inc:=GetNumber('inc',inc);


  for i:= 1 to nrot do begin
   SelectSlice(i+start-1);
   SelectAll;
   SetScaling('Bilinear; Same Window');
   ScaleAndRotate(1.00,1.00,(i-1)*inc)
  end;
  
  
  for i:= iend to nSlices do begin
   SelectSlice(i);
   SelectAll;
   SetScaling('Bilinear; Same Window');
   ScaleAndRotate(1.00,1.00,180)
  end;
end;


macro 're-center rotation 0-180 [K]';
var
  i,inc,sense,x0,y0,xL,yL,xm,ym,w,h,xp,yp:integer;
  delx0,dely0,start,iend,steps:integer;
  factor,pi,rad,deltX,deltY,ang0,ang,r,rc,rs:real;
begin

   factor:= 0.01745329252;   { pi/180 }
   pi:= 3.14159265358979;
   rad:= 57.29577951308;

 CheckForStack;
 sense:=1;
 start:=3;

 start:=GetNumber('first slice that needs to be recentered',start);

 inc:=GetNumber('increment:',10);
 steps:=180/inc;
 inc:=factor*inc;
 iend:=start+steps;

SelectSlice(start);
PutMessage('place mouse at reference point and press <return>');
 Getmouse(x0,y0);
SelectSlice(iend);
PutMessage('place mouse at reference point and press <return>');
 Getmouse(xL,yL);
sense:=GetNumber(' rotation of reference point (CLW=1 CCLW=0) ?',sense);

 if sense = 0 then begin
  inc:=-inc;
  end;

xm:=(x0+xL)/2;
ym:=(y0+yL)/2;
delx0:=(x0-xm);
dely0:=(y0-ym);


r:=sqrt(delx0*delx0+dely0*dely0);
ang0:=90;
if delx0<>0 then ang0:=arctan(dely0/delx0);

  for i:= 1 to steps+1 do begin
   ang:=ang0+(i-1)*inc;
   rc:=r*cos(ang);
   rs:=r*sin(ang);

   if (xl > x0) and (yl < y0) then begin
   deltX:=-delx0+r*cos(ang);
   deltY:=-dely0+r*sin(ang);
   end;

   if (xl < x0) and (yl < y0) then begin
   deltX:=-r*cos(ang);
   deltY:=-r*sin(ang);
   end;

   if (xl < x0) and (yl > y0) then begin
   deltX:= delx0-r*cos(ang);
   deltY:= dely0-r*sin(ang);
   end;

   if (xl > x0) and (yl > y0) then begin
   deltX:= r*cos(ang);
   deltY:= r*sin(ang);
   end;

   SelectSlice(i+start-1);
   SelectAll;
   Copy;
   MoveRoi(deltX,deltY);
   Paste;
   DoCopy;
  end;
end;





macro '(-' begin end;


macro 'import Text LUT';
var
  i,r,g,b, width, height, start, row:integer;
  
begin

PutMessage('Imports LUT in the form of 3 column RGB text file (use Classic Mac CR!). If there are 4 columns, the first column is ignored.');
  SetImport('Text');
  Import('');

  GetPicSize(width,height);
  if width=3 then begin
    r:=0;
    g:=1;
    b:=2
  end else if width=4 then begin
      r:=1;
      g:=2;
      b:=3
  end else begin
    PutMessage('The text file must have either 3 or 4 columns.');
    exit;
  end;

  if height=255 then
    start:=1
  else if height=256 then
      start:=0
  else begin
      PutMessage('The text file must have either 255 or 256 rows.');
      exit;
   end;

  i:=start;
  row:=0;
  repeat
    RedLut[i]:=GetPixel(r,row);
    GreenLut[i]:=GetPixel(g,row);
    BlueLut[i]:=GetPixel(b,row);
    if (i mod 10) = 0 then UpdateLUT;
    i:=i+1;
    row:=row+1;
  until row>=height;
  UpdateLUT;
end;



macro 'apply camera LUT [Y]';
var
  i:integer;
  Pal,Palpath,Palname: string;
  
begin

PutMessage('This macro applies a LUT (Palette) to the stack. It assumes the Palette is in the same folder as the stack.');

CheckForStack;

Palpath:=GetPath('window');
Pal:=GetString('Palette: ','Palette micro-660nm.CAL');
Palname:=concat(Palpath,Pal);

Palname:=GetString('Full path to Palette name = ', Palname);

SetImport('Palette');

for i:=1 to nSlices do begin
Import(Palname);
  ChooseSlice(i);
UpdateLUT;
ApplyLUT;
end;

SelectSlice(1);
end;


macro 'invert stack';

var
  i:integer;
begin
Checkforstack;
for i:=1 to nSlices do begin
SelectSlice(i);
invert;
end;
end;





macro '(-' begin end;


macro 'flare-correct rotated images [F]';
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth,rotstart,rotend,deg,degmin:integer;
  ScaleFactor,angle,flare, flare0,flare90,s:real;
begin

  CheckForStack;
  N:=nSlices;
  flare0:=GetNumber('max flare: ',170);
  flare90:=GetNumber('min flare: ',160);
  degmin:=GetNumber('angle of flare minimum: ',90);

  rotstart:=GetNumber('first rotationd image at slice: ',3);
  rotend:=GetNumber('last rotation image at slice: ',21);

  
for i:= rotstart to rotend do begin
  SelectSlice(i);
  deg:=(i-rotstart)*10 +degmin;
  s:=sin(0.017453292519943*deg);
  flare:=flare90+ (flare0-flare90)*s*s;
  flare:=flare/flare0;
  SelectAll;
  MultiplyByConstant(flare);

end;

end;


macro 'REAL flat field                       [S]';
var
  Pal,Palpath,Palname: string;
  back,pic,flatfield,corr:integer;
  left,top,width,height,nn,mean,mean,mode,min,max:integer;

  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle,flare, flare0:real;


begin

  CheckForStack;
  CheckForSelection;

  GetRoi(left,top,width,height);
  OldStack:=PicNumber;
  N:=nSlices;
  SelectAll;
  SelectSlice(1);
  flatfield:=GetNumber('Flat field image is on Slice: ',N);

  SelectPic(OldStack);
  SelectSlice(flatfield);
  Copy;


SetNewSize(width,height);
MakeNewWindow('back');
back:=PicNumber;
Paste;
Invert;

  SetNewSize(width,height);
  MakeNewStack('StackFlat');
  NewStack:=PicNumber;

  for i:= 1 to N do begin
    SelectPic(OldStack);
    SelectSlice(i);
    SelectAll;
    Copy;

SetNewSize(width,height);
MakeNewWindow('pic');
pic:=PicNumber;
Paste;
Invert;

ImageMath('div real',pic, back, 1.,0.,'corr');
corr:=PicNumber;
SelectPic(corr);
SelectAll;
Invert;
Copy;

    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;

    SelectPic(corr);
    Dispose;
    SelectPic(pic);
    Dispose;

  end;

    SelectPic(back);
    Dispose;
{
    SelectPic(OldStack);
    SelectSlice(1);

    SelectPic(NewStack);
    SelectSlice(1);
}
end;



macro 'REAL subtract background    [Z]';
var
  Pal,Palpath,Palname: string;
  back,pic,flatfield,corr:integer;
  left,top,width,height,nn,mean,mean,mode,min,max:integer;

  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor,angle,flare, flare0:real;


begin

  CheckForStack;
  CheckForSelection;

  GetRoi(left,top,width,height);
  OldStack:=PicNumber;
  N:=nSlices;
  SelectAll;
  SelectSlice(1);
  flatfield:=GetNumber('Flat field image is on Slice: ',N);

  SelectPic(OldStack);
  SelectSlice(flatfield);
  Copy;


SetNewSize(width,height);
MakeNewWindow('back');
back:=PicNumber;
Paste;
Invert;

  SetNewSize(width,height);
  MakeNewStack('StackFlat');
  NewStack:=PicNumber;

  for i:= 1 to N do begin
    SelectPic(OldStack);
    SelectSlice(i);
    SelectAll;
    Copy;

SetNewSize(width,height);
MakeNewWindow('pic');
pic:=PicNumber;
Paste;
Invert;

ImageMath('sub real',pic, back, 1.,0.,'corr');
corr:=PicNumber;
SelectPic(corr);
SelectAll;
Invert;
Copy;

    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;

    SelectPic(corr);
    Dispose;
    SelectPic(pic);
    Dispose;

  end;

    SelectPic(back);
    Dispose;
{
    SelectPic(OldStack);
    SelectSlice(1);

    SelectPic(NewStack);
    SelectSlice(1);
}
end;


macro 'rolling ball [B]';
var
  radius: integer;
begin
  radius:= GetNumber('radius ?', 100);
  SubtractBackground('2D Rolling Ball',radius);
end;



macro '(-' begin end;


macro 'merge tilts                   [T]';
var
  answer,near,far:integer
  weight,reduce:boolean;
begin
 weight:=false;
 reduce:=false;
 CheckForStack;
PutMessage('You will now create one mrged image from ',nSlices,' slices');
near:=GetNumber(' near limit ?',1);
far:=GetNumber(' far limit ?',6);
weight:=GetNumber(' weighted (no=0, yes=1) ?',weight);
reduce:=GetNumber(' reduce noise (no=0, yes=1) ?',reduce);
DepthOfFocus(near,far,weight,reduce);
end;



macro 'check averages of tilts [M]';
var
eup,sup,last,n,mean,mode,min,max,standard,corr:integer;

begin
 CheckForStack;
 last:=GetNumber('reference (rotation 180) is on slice no.?',21);
 eup:=GetNumber('1st compare (eup) is on slice no.?',22);
 sup:=GetNumber('2nd compare (sup) is on slice no.?',23);

 ChooseSlice(last);
 SelectAll;
 Measure;
 GetResults(n,mean,mode,min,max);
 standard:=mean;

 ChooseSlice(eup);
 SelectAll;
 Measure;
 GetResults(n,mean,mode,min,max);
 corr:=standard-mean;
 corr:=GetNumber('EUP - ',corr);
 Addconstant(corr);

 ChooseSlice(sup);
 SelectAll;
 Measure;
 GetResults(n,mean,mode,min,max);
 corr:=standard-mean;
 corr:=GetNumber('SUP - ',corr);
 Addconstant(corr);

end;



macro '(-' begin end;


macro 'smooth stack from to ... [C]';
var
  i,istart,iend:integer;
begin

checkforstack;

istart:=GetNumber('first slice for smoothing: ',21);
iend:=GetNumber('last slice for smoothing: ',23);

  for i:=istart to iend do begin
  SelectSlice(i);
  Filter('Smooth');
  end;
SelectSlice(1);
end;



macro 'average stack                 [A]';
begin
AverageSlices;
end;



macro 'Grayscale                       [G]';

begin
SetPalette('Grayscale');
end;



macro 'invert image                    [J]';

begin
invert;
end;


macro 'scale to pixel                  [P]';
begin
SetScale(0,'pixel');
end;


macro '(-' begin end;


MACRO 'export stack to RAW - 19 rot [E]';
var
zero,i,j,w,h:   integer;
fname  :    string;

   BEGIN
 
   GetPicSize(w,h);
   fname:=GetString('Filename? (no extension)',WindowTitle);

    zero:=GetNumber(concat('circular polarization (',fname,'.cirpol) is on slice no.?'),1);
    SelectSlice(zero);

    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.cirpol');
    Paste;
        Export;
            Dispose;

    zero:=GetNumber(concat('no polarization (',fname,'.nopol) is on slice no.?'),2);
    SelectSlice(zero);

    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.nopol');
    Paste;
        Export;
            Dispose;


   zero:=GetNumber(concat('first rotation (',fname,'.000) is on slice no.?'),3);

   for i:=zero to zero+18 do begin
    j:=(i-zero)*10;
    SelectSlice(i);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.',j:3);
    Paste;
        Export;
          Dispose;
   end; 


   zero:=GetNumber(concat('first tilt (',fname,'.eup) is on slice no.?'),22);

    SelectSlice(zero);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.eup');
    Paste;
        Export;
            Dispose;

    SelectSlice(zero+1);
    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.sup');
    Paste;
        Export;
            Dispose;


    zero:=GetNumber(concat('background  (',fname,'.back) is on slice no.?'),24);
    SelectSlice(zero);

    SelectAll;
    Copy;
    SetNewSize(w,h);
    MakeNewWindow(fname,'.back');
    Paste;
        Export;
            Dispose;

end;


end;
